home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_d / printset.zip / EDSPRINT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-09  |  17KB  |  513 lines
  1. unit EDSPrint;
  2.   {unit to programmatically set printer options so that user does not}
  3.   {have to go to the Printer Options Dialog Box}
  4.   {Revision 1.5}
  5. interface
  6. uses
  7.   Classes, Forms, Printers, SysUtils, Print, WinProcs, WinTypes, Messages;
  8.             {see the WinTypes unit for constant declarations such as}
  9.             {dmPaper_Letter, dmbin_Upper, etc}
  10.  
  11. const
  12.   CCHBinName  = 24;  {Size of bin name (should have been in PRINT.PAS}
  13.   CBinMax     = 256; {Maximum number of bin sources}
  14.   CPaperNames = 256; {Maximum number of paper sizes}
  15. type
  16.   TPrintSet = class (TComponent)
  17.   private
  18.     { Private declarations }
  19.     FDevice:     PChar;
  20.     FDriver:     PChar;
  21.     FPort:       PChar;
  22.     FHandle:     THandle;
  23.     FDeviceMode: PDevMode;
  24.   protected
  25.     { Protected declarations }
  26.     procedure   SetOrientation (Orientation: integer);
  27.     function    GetOrientation: integer;
  28.       {-sets/gets the paper orientation}
  29.     procedure   SetPaperSize (Size: integer);
  30.     function    GetPaperSize: integer;
  31.       {-sets/gets the paper size}
  32.     procedure   SetPaperLength (Length: integer);
  33.     function    GetPaperLength: integer;                     
  34.       {-sets/gets the paper length}
  35.     procedure   SetPaperWidth (Width: integer);
  36.     function    GetPaperWidth: integer;
  37.       {-sets/gets the paper width}
  38.     procedure   SetScale (Scale: integer);
  39.     function    GetScale: integer;
  40.       {-sets/gets the printer scale (whatever that is)}
  41.     procedure   SetCopies (Copies: integer);
  42.     function    GetCopies: integer;
  43.       {-sets/gets the number of copies}
  44.     procedure   SetBin (Bin: integer);
  45.     function    GetBin: integer;
  46.       {-sets/gets the paper bin}
  47.     procedure   SetPrintQuality (Quality: integer);
  48.     function    GetPrintQuality: integer;
  49.       {-sets/gets the print quality}
  50.     procedure   SetColor (Color: integer);
  51.     function    GetColor: integer;
  52.       {-sets/gets the color (monochrome or color)}
  53.     procedure   SetDuplex (Duplex: integer);
  54.     function    GetDuplex: integer;
  55.       {-sets/gets the duplex setting}
  56.     procedure   SetYResolution (YRes: integer);
  57.     function    GetYResolution: integer;
  58.       {-sets/gets the y-resolution of the printer}
  59.     procedure   SetTTOption (Option: integer);
  60.     function    GetTTOption: integer;
  61.       {-sets/gets the TrueType option}
  62.   public
  63.     { Public declarations }
  64.     constructor Create (AOwner: TComponent); override;
  65.       {-initializes object}
  66.     destructor  Destroy;  override;
  67.       {-destroys class}
  68.     function    GetBinSourceList: TStringList;
  69.       {-returns the current list of bins}
  70.     function    GetPaperList: TStringList;
  71.       {-returns the current list of paper sizes}
  72.     procedure   SetDeviceMode;
  73.       {-updates the printers TDevMode structure}
  74.     procedure   SaveToDefaults;
  75.       {-updates the default settings for the current printer}
  76.  
  77.     { Property declarations }
  78.     property Orientation: integer     read   GetOrientation
  79.                                       write  SetOrientation;
  80.     property PaperSize: integer       read   GetPaperSize
  81.                                       write  SetPaperSize;
  82.     property PaperLength: integer     read   GetPaperLength
  83.                                       write  SetPaperLength;
  84.     property PaperWidth: integer      read   GetPaperWidth
  85.                                       write  SetPaperWidth;
  86.     property Scale: integer           read   GetScale
  87.                                       write  SetScale;
  88.     property Copies: integer          read   GetCopies
  89.                                       write  SetCopies;
  90.     property DefaultSource: integer   read   GetBin
  91.                                       write  SetBin;
  92.     property PrintQuality: integer    read   GetPrintQuality
  93.                                       write  SetPrintQuality;
  94.     property Color: integer           read   GetColor
  95.                                       write  SetColor;
  96.     property Duplex: integer          read   GetDuplex
  97.                                       write  SetDuplex;
  98.     property YResolution: integer     read   GetYResolution
  99.                                       write  SetYResolution;
  100.     property TTOption: integer        read   GetTTOption
  101.                                       write  SetTTOption;
  102.   end;  { TPrintSet }
  103.  
  104. procedure Register;
  105.   {-registers the printset component}
  106.  
  107. implementation
  108.  
  109. constructor TPrintSet.Create (AOwner: TComponent); 
  110.   {-initializes object}
  111. begin
  112.   inherited Create (AOwner);
  113.   if not (csDesigning in ComponentState) then
  114.   begin
  115.     GetMem (FDevice, 255);
  116.     GetMem (FDriver, 255);
  117.     GetMem (FPort, 255);
  118.     Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  119.     if FHandle = 0 then
  120.     begin  {driver not loaded}
  121.       Printer.PrinterIndex := Printer.PrinterIndex;
  122.         {-forces Printer object to load driver}
  123.     end;  { if... }
  124.     Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
  125.     if FHandle<>0 then
  126.     begin
  127.       FDeviceMode := Ptr (FHandle, 0);
  128.         {-PDeviceMode now points to Printer.DeviceMode}
  129.       FDeviceMode^.dmFields := 0;
  130.     end {:} else
  131.     begin
  132.       FDeviceMode := nil;
  133.       Raise EPrinter.Create ('Error retrieving DeviceMode');
  134.     end;  { if... }
  135.   end {:} else
  136.   begin
  137.     FDevice := nil;
  138.     FDriver := nil;
  139.     FPort   := nil;
  140.   end;  { if... }
  141. end;  { TPrintSet.Create }
  142.  
  143. function TPrintSet.GetBinSourceList: TStringList;
  144.   {-returns the current list of bins (returns nil for none)}
  145. type
  146.   TcchBinName = array[0..CCHBinName-1] of Char;
  147.   TBinArray   = array[1..cBinMax] of TcchBinName;
  148.   PBinArray   = ^TBinArray;
  149. var
  150.   NumBinsReq:   Longint;      {number of bins required}
  151.   NumBinsRec:   Longint;      {number of bins received}
  152.   BinArray:     PBinArray;
  153.   BinList:      TStringList;
  154.   BinStr:       String;
  155.   i:            Longint;
  156.   DevCaps:      TFarProc;
  157.   DrvHandle:    THandle;
  158.   DriverName:   String;
  159. begin
  160.   Result   := nil;
  161.   BinArray := nil;
  162.   try
  163.     DrvHandle := LoadLibrary (FDriver);
  164.     if DrvHandle <> 0 then
  165.     begin
  166.       DevCaps := GetProcAddress (DrvHandle, 'DeviceCapabilities');
  167.       if DevCaps<>nil then
  168.       begin
  169.         NumBinsReq := TDeviceCapabilities (DevCaps)(FDevice, FPort, DC_BinNames,
  170.                                                     nil, FDeviceMode^);
  171.         GetMem (BinArray, NumBinsReq * SizeOf (TcchBinName));
  172.         NumBinsRec := TDeviceCapabilities (DevCaps)(FDevice, FPort, DC_BinNames,
  173.                                                     PChar (BinArray), FDeviceMode^);
  174.         if NumBinsRec <> NumBinsReq then
  175.         begin
  176.           {raise an exception}
  177.           Raise EPrinter.Create ('Error retrieving Bin Source Info');
  178.         end;  { if... }
  179.         {now convert to TStringList}
  180.         BinList := TStringList.Create;
  181.         for i := 1 to NumBinsRec do
  182.         begin
  183.           BinStr := StrPas (BinArray^[i]);
  184.           BinList.Add (BinStr);
  185.         end;  { next i }
  186.       end;  { if... }
  187.       FreeLibrary (DrvHandle);
  188.       Result := BinList;
  189.     end {:} else
  190.     begin
  191.       {raise an exception}
  192.       DriverName := StrPas (FDriver);
  193.       Raise EPrinter.Create ('Error loading driver '+DriverName);
  194.     end;  { else }
  195.   finally
  196.     if BinArray <> nil then
  197.       FreeMem (BinArray, NumBinsReq * SizeOf (TcchBinName));
  198.   end;  { try }
  199. end;  { TPrintSet.GetBinSourceList }
  200.  
  201. function TPrintSet.GetPaperList: TStringList;
  202.   {-returns the current list of paper sizes (returns nil for none)}
  203. type
  204.   TcchPaperName = array[0..CCHPaperName-1] of Char;
  205.   TPaperArray   = array[1..cPaperNames] of TcchPaperName;
  206.   PPaperArray   = ^TPaperArray;
  207. var
  208.   NumPaperReq:   Longint;      {number of paper types required}
  209.   NumPaperRec:   Longint;      {number of paper types received}
  210.   PaperArray:    PPaperArray;
  211.   PaperList:     TStringList;
  212.   PaperStr:      String;
  213.   i:             Longint;
  214.   DevCaps:       TFarProc;
  215.   DrvHandle:     THandle;
  216.   DriverName:    String;
  217. begin
  218.   Result     := nil;
  219.   PaperArray := nil;
  220.   try
  221.     DrvHandle := LoadLibrary (FDriver);
  222.     if DrvHandle <> 0 then
  223.     begin
  224.       DevCaps := GetProcAddress (DrvHandle, 'DeviceCapabilities');
  225.       if DevCaps<>nil then
  226.       begin
  227.         NumPaperReq := TDeviceCapabilities (DevCaps)(FDevice, FPort, DC_PaperNames,
  228.                                                      nil, FDeviceMode^);
  229.         GetMem (PaperArray, NumPaperReq * SizeOf (TcchPaperName));
  230.         NumPaperRec := TDeviceCapabilities (DevCaps)(FDevice, FPort, DC_PaperNames,
  231.                                                      PChar (PaperArray), FDeviceMode^);
  232.         if NumPaperRec <> NumPaperReq then
  233.         begin
  234.           {raise an exception}
  235.           Raise EPrinter.Create ('Error retrieving Paper Info');
  236.         end;  { if... }
  237.         {now convert to TStringList}
  238.         PaperList := TStringList.Create;
  239.         for i := 1 to NumPaperRec do
  240.         begin
  241.           PaperStr := StrPas (PaperArray^[i]);
  242.           PaperList.Add (PaperStr);
  243.         end;  { next i }
  244.       end;  { if... }
  245.       FreeLibrary (DrvHandle);
  246.       Result := PaperList;
  247.     end {:} else
  248.     begin
  249.       {raise an exception}
  250.       DriverName := StrPas (FDriver);
  251.       Raise EPrinter.Create ('Error loading driver '+DriverName);
  252.     end;  { else }
  253.   finally
  254.     if PaperArray <> nil then
  255.       FreeMem (PaperArray, NumPaperReq * SizeOf (TcchPaperName));
  256.   end;  { try }
  257. end;  { TPrintSet.GetPaperList }
  258.  
  259. procedure TPrintSet.SetDeviceMode;
  260.   {-updates the drived TDevMode structure}
  261. var
  262.   DrvHandle:   THandle;
  263.   ExtDevCaps:  TFarProc;
  264.   DriverName:  String;
  265.   ExtDevCode:  Integer;
  266.   OutDevMode:  PDevMode;
  267. begin
  268.   DrvHandle := LoadLibrary (FDriver);
  269.   if DrvHandle <> 0 then
  270.   begin
  271.     ExtDevCaps := GetProcAddress (DrvHandle, 'ExtDeviceMode');
  272.     if ExtDevCaps<>nil then
  273.     begin
  274.       ExtDevCode := TExtDeviceMode (ExtDevCaps)
  275.         (0, DrvHandle, FDeviceMode^, FDevice, FPort,
  276.          FDeviceMode^, nil, DM_IN_BUFFER or DM_OUT_BUFFER);
  277.       if ExtDevCode <> IDOK then
  278.       begin
  279.         {raise an exception}
  280.         raise EPrinter.Create ('Error updating printer driver.');
  281.       end;  { if... }
  282.     end;  { if... }
  283.     FreeLibrary (DrvHandle);
  284.   end {:} else
  285.   begin
  286.     {raise an exception}
  287.     DriverName := StrPas (FDriver);
  288.     Raise EPrinter.Create ('Error loading driver '+DriverName);
  289.   end;  { else }
  290. end;  { TPrintSet.SetDeviceMode }
  291.  
  292. procedure TPrintSet.SaveToDefaults;
  293.   {-updates the default settings for the current printer}
  294. var
  295.   DrvHandle:   THandle;
  296.   ExtDevCaps:  TFarProc;
  297.   DriverName:  String;
  298.   ExtDevCode:  Integer;
  299.   OutDevMode:  PDevMode;
  300. begin
  301.   DrvHandle := LoadLibrary (FDriver);
  302.   if DrvHandle <> 0 then
  303.   begin
  304.     ExtDevCaps := GetProcAddress (DrvHandle, 'ExtDeviceMode');
  305.     if ExtDevCaps<>nil then
  306.     begin
  307.       ExtDevCode := TExtDeviceMode (ExtDevCaps)
  308.         (0, DrvHandle, FDeviceMode^, FDevice, FPort,
  309.          FDeviceMode^, nil, DM_IN_BUFFER OR DM_UPDATE);
  310.       if ExtDevCode <> IDOK then
  311.       begin
  312.         {raise an exception}
  313.         raise EPrinter.Create ('Error updating printer driver.');
  314.       end {:} else
  315.         SendMessage ($FFFF, WM_WININICHANGE, 0, 0);
  316.     end;  { if... }
  317.     FreeLibrary (DrvHandle);
  318.   end {:} else
  319.   begin
  320.     {raise an exception}
  321.     DriverName := StrPas (FDriver);
  322.     Raise EPrinter.Create ('Error loading driver '+DriverName);
  323.   end;  { else }
  324. end;  { TPrintSet.SaveToDefaults }
  325.  
  326. procedure TPrintSet.SetOrientation (Orientation: integer);
  327.   {-sets the paper orientation}
  328. begin
  329.   FDeviceMode^.dmOrientation := Orientation;
  330.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
  331. end;  { TPrintSet.SetOrientation }
  332.  
  333. function TPrintSet.GetOrientation: integer;
  334.   {-gets the paper orientation}
  335. begin
  336.   Result := FDeviceMode^.dmOrientation;
  337. end;  { TPrintSet.GetOrientation }
  338.  
  339. procedure TPrintSet.SetPaperSize (Size: integer);
  340.   {-sets the paper size}
  341. begin
  342.   FDeviceMode^.dmPaperSize := Size;
  343.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERSIZE;
  344. end;  { TPrintSet.SetPaperSize }
  345.  
  346. function TPrintSet.GetPaperSize: integer;
  347.   {-gets the paper size}
  348. begin
  349.   Result := FDeviceMode^.dmPaperSize;
  350. end;  { TPrintSet.GetPaperSize }
  351.  
  352. procedure TPrintSet.SetPaperLength (Length: integer);
  353.   {-sets the paper length}
  354. begin
  355.   FDeviceMode^.dmPaperLength := Length;
  356.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERLENGTH;
  357. end;  { TPrintSet.SetPaperLength }
  358.  
  359. function TPrintSet.GetPaperLength: integer;
  360.   {-gets the paper length}
  361. begin
  362.   Result := FDeviceMode^.dmPaperLength;
  363. end;  { TPrintSet.GetPaperLength }
  364.  
  365. procedure TPrintSet.SetPaperWidth (Width: integer);
  366.   {-sets the paper width}
  367. begin
  368.   FDeviceMode^.dmPaperWidth := Width;
  369.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERWIDTH;
  370. end;  { TPrintSet.SetPaperWidth }
  371.  
  372. function TPrintSet.GetPaperWidth: integer;
  373.   {-gets the paper width}
  374. begin
  375.   Result := FDeviceMode^.dmPaperWidth;
  376. end;  { TPrintSet.GetPaperWidth }
  377.  
  378. procedure TPrintSet.SetScale (Scale: integer);
  379.   {-sets the printer scale (whatever that is)}
  380. begin
  381.   FDeviceMode^.dmScale := Scale;
  382.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_SCALE;
  383. end;  { TPrintSet.SetScale }
  384.  
  385. function TPrintSet.GetScale: integer;
  386.   {-gets the printer scale}
  387. begin
  388.   Result := FDeviceMode^.dmScale;
  389. end;  { TPrintSet.GetScale }
  390.  
  391. procedure TPrintSet.SetCopies (Copies: integer);
  392.   {-sets the number of copies}
  393. begin
  394.   FDeviceMode^.dmCopies := Copies;
  395.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_COPIES;
  396. end;  { TPrintSet.SetCopies }
  397.  
  398. function TPrintSet.GetCopies: integer;
  399.   {-gets the number of copies}
  400. begin
  401.   Result := FDeviceMode^.dmCopies;
  402. end;  { TPrintSet.GetCopies }
  403.  
  404. procedure TPrintSet.SetBin (Bin: integer);
  405.   {-sets the paper bin}
  406. begin
  407.   FDeviceMode^.dmDefaultSource := Bin;
  408.   FDeviceMode^.dmFields  := FDeviceMode^.dmFields or DM_DEFAULTSOURCE;
  409. end;  { TPrintSet.SetBin }
  410.  
  411. function TPrintSet.GetBin: integer;
  412.   {-gets the paper bin}
  413. begin
  414.   Result := FDeviceMode^.dmDefaultSource;
  415. end;  { TPrintSet.GetBin }
  416.  
  417. procedure TPrintSet.SetPrintQuality (Quality: integer);
  418.   {-sets the print quality}
  419. begin
  420.   FDeviceMode^.dmPrintQuality := Quality;
  421.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PRINTQUALITY;
  422. end;  { TPrintSet.SetPrintQuality }
  423.  
  424. function TPrintSet.GetPrintQuality: integer;
  425.   {-gets the print quality}
  426. begin
  427.   Result := FDeviceMode^.dmPrintQuality;
  428. end;  { TPrintSet.GetPrintQuality }
  429.  
  430. procedure TPrintSet.SetColor (Color: integer);
  431.   {-sets the color (monochrome or color)}
  432. begin
  433.   FDeviceMode^.dmColor := Color;
  434.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
  435. end;  { TPrintSet.SetColor }
  436.  
  437. function TPrintSet.GetColor: integer;
  438.   {-gets the color}
  439. begin
  440.   Result := FDeviceMode^.dmColor;
  441. end;  { TPrintSet.GetColor }
  442.  
  443. procedure TPrintSet.SetDuplex (Duplex: integer);
  444.   {-sets the duplex setting}
  445. begin
  446.   FDeviceMode^.dmDuplex := Duplex;
  447.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DUPLEX;
  448. end;  { TPrintSet.SetDuplex }
  449.  
  450. function TPrintSet.GetDuplex: integer;
  451.   {-gets the duplex setting}
  452. begin
  453.   Result := FDeviceMode^.dmDuplex;
  454. end;  { TPrintSet.GetDuplex }
  455.  
  456. procedure TPrintSet.SetYResolution (YRes: integer);
  457.   {-sets the y-resolution of the printer}
  458. var
  459.   PrintDevMode: Print.PDevMode;
  460. begin
  461.   PrintDevMode := @FDeviceMode^;
  462.   PrintDevMode^.dmYResolution := YRes;
  463.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_YRESOLUTION;
  464. end;  { TPrintSet.SetYResolution }
  465.  
  466. function  TPrintSet.GetYResolution: integer;
  467.   {-gets the y-resolution of the printer}
  468. var
  469.   PrintDevMode: Print.PDevMode;
  470. begin
  471.   PrintDevMode := @FDeviceMode^;
  472.   Result := PrintDevMode^.dmYResolution;
  473. end;  { TPrintSet.GetYResolution }
  474.  
  475. procedure TPrintSet.SetTTOption (Option: integer);
  476.   {-sets the TrueType option}
  477. var
  478.   PrintDevMode: Print.PDevMode;
  479. begin
  480.   PrintDevMode := @FDeviceMode^;
  481.   PrintDevMode^.dmTTOption := Option;
  482.   FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_TTOPTION;
  483. end;  { TPrintSet.SetTTOption }
  484.  
  485. function TPrintSet.GetTTOption: integer;
  486.   {-gets the TrueType option}
  487. var
  488.   PrintDevMode: Print.PDevMode;
  489. begin
  490.   PrintDevMode := @FDeviceMode^;
  491.   Result := PrintDevMode^.dmTTOption;
  492. end;  { TPrintSet.GetTTOption }
  493.  
  494. destructor TPrintSet.Destroy;
  495.   {-destroys class}
  496. begin
  497.   if FDevice <> nil then
  498.     FreeMem (FDevice, 255);
  499.   if FDriver <> nil then
  500.     FreeMem (FDriver, 255);
  501.   if FPort <> nil then
  502.     FreeMem (FPort, 255);
  503.   inherited Destroy;
  504. end; { TPrintSet.Destroy }
  505.  
  506. procedure Register;
  507.   {-registers the printset component}
  508. begin
  509.   RegisterComponents('Domain', [TPrintSet]);
  510. end;  { Register }
  511.  
  512. end.  { EDSPrint }
  513.